SplitNetwork Subroutine

private subroutine SplitNetwork(orders, flowDirection, split)

Split channel network where a confluence of two different horton order channels occurs

Arguments

Type IntentOptional Attributes Name
type(grid_integer), intent(in) :: orders
type(grid_integer), intent(in) :: flowDirection
type(grid_integer), intent(inout) :: split

Variables

Type Visibility Attributes Name Initial
integer, public :: col
integer, public :: hortonOrder
integer, public :: i
integer, public :: j
integer, public :: row
logical, public :: splitFound

Source Code

SUBROUTINE SplitNetwork  &
!
(orders, flowDirection, split)

IMPLICIT NONE

!Arguments with intent in:
TYPE(grid_integer), INTENT(in) :: orders
TYPE(grid_integer), INTENT(in) :: flowDirection

!Arguments with intent out
TYPE(grid_integer),INTENT(inout):: split


!local declaration:
INTEGER :: i,j
INTEGER :: row, col
INTEGER :: hortonOrder
LOGICAL :: splitFound

!-----------------------end of declaration-------------------------------------

DO i = 1, split % idim
  DO j = 1, split % jdim
    !IF (channel % mat (i,j) /= channel % nodata) THEN
      hortonOrder = orders % mat (i,j) 
      splitFound = .FALSE.
      
      !check EAST cell
      row = i 
      col = j + 1
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == W .AND. &
            !channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      !check SOUTH-EAST cell
      row = i + 1
      col = j + 1
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == NW .AND. &
           ! channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder ) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      !check SOUTH cell
      row = i + 1
      col = j
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == N .AND. &
          !  channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder ) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      !check SOUTH-WEST cell
      row = i + 1
      col = j - 1
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == NE .AND. &
          !  channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder ) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      !check WEST cell
      row = i 
      col = j - 1
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == E .AND. &
          !  channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      !check NORTH-EAST cell
      row = i - 1
      col = j - 1
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == SE .AND. &
         !   channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      !check NORTH cell
      row = i - 1
      col = j
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == S .AND. &
        !    channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder ) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      !check NORTH-EAST cell
      row = i - 1
      col = j + 1
      IF ( .NOT. IsOutOfGrid(row,col,split) ) THEN
        IF (flowDirection % mat (row,col) == SW .AND. &
        !    channel % mat (row,col) /= channel % nodata .AND. &
            orders % mat (row,col) <  hortonOrder) THEN
           splitFound = .TRUE.
           split % mat (i,j) = 1
           CYCLE
        END IF
      END IF
      
      IF ( .NOT. splitFound ) THEN
        split % mat (i,j) = split % nodata
      END IF
      
    !ELSE
    !  split % mat (i,j) = split % nodata
    !END IF
    
    
  END DO
END DO

END SUBROUTINE SplitNetwork